The Business Master (3rd Edition)/The Business Master (3rd Edition).iso/files/grapties/sd204/address.pas

Pascal/Delphi Source File | 1980-01-01 | 12.3 KB | 373 lines

PROGRAM Address;
{=================================================================}
{ This program is a simple address list manager that shows how to }
{ use BOX screens effectively in three differerent ways:          }
{                                                                 }
{     Logo screens -- the Logo screen was created using BOX       }
{                                                                 }
{     Help screens -- Context sensitive help screens were created }
{                     using BOX and are displayed when requested  }
{                     by a special keystroke intercept routine    }
{                     that watches each keystroke for F1.         }
{                                                                 }
{     Data screens -- The data entry screen used for the          }
{                     entry of address was created by BOX and     }
{                     displayed by the routines in LOADFILE       }
{                                                                 }

USES IOSTUFF,LOADFILE,MENUBOX,GETLNE,KEY2,CRT;

{ Source code for the Units above are included on the BOX disk.   }
{ These Units are part of the Turbo Overdrive Package (TOP),      }
{ a collection of useful subroutines from Nescatunga Software.    }
{ If you register for TOP ($20) you will recieve the entire TOP   }
{ collection of over 40 subroutines along with complete           }
{ documentation.  TOP includes pulldown menus, a popup calculator }
{ point and shoot file selector and much more.                    }

TYPE

  Rec = Record                      { Address Record }
          Name      : String[30];
          Street    : String[20];
          Town      : String[20];
          State     : String[2];
          Zip       : String[7];
          Notes1    : String[43];
          Notes2    : String[43];
        End;

  RecFile = File of Rec;


VAR
    FilevarM   : File;        { File of addresses }
    Addr       : Array[1..100] of Rec; { Array of address records }
    NumRec     : Integer;     { Number of records }
    CurIndx    : Integer;     { Index of current record }
    II         : Integer;     { Misc. looping index }
    Escaped    : Boolean;     { True if user hit Esc. in SelectRec }
    BigExit    : Boolean;     { Exit switch       }
    Ch         : Char;        { Input character   }
    HoldRec    : Rec;         { A temporary holding record }
{=================================================================}
PROCEDURE BlankFields;

{ Blanks out the fields on the screen                             }

BEGIN
    WriteSt('                              ',22,11);
    WriteSt('                    ',22,13);
    WriteSt('                    ',22,15);
    WriteSt('  ',50,15);
    WriteSt('       ',58,15);
    WriteSt('                                           ',22,17);
    WriteSt('                                           ',22,19);
END;

{=================================================================}
PROCEDURE ShowRec(NewRec : Rec);

{ Displays the contents of Address record NewRec on the Screen }

BEGIN
  BlankFields;
  With NewRec do
  Begin
    WriteSt(Name,22,11);
    WriteSt(Street,22,13);
    WriteSt(Town,22,15);
    WriteSt(State,50,15);
    WriteSt(Zip,58,15);
    WriteSt(Notes1,22,17);
    WriteSt(Notes2,22,19);
  end;
END;

{=========================================================}
PROCEDURE GetNewRec(VAR NewRec : Rec);

{ Accepts input for each of the fields in the record }

BEGIN
    BlankFields;       { Blank the displayed record on screen }
    With NewRec do
    Begin
       Name      := GetStr(22,11,30,'');
       Street    := GetStr(22,13,20,'');
       Town      := GetStr(22,15,20,'');
       State     := GetStr(50,15,2,'');
       Zip       := GetStr(58,15,7,'');
       Notes1    := GetStr(22,17,43,'');
       Notes2    := GetStr(22,19,43,'');
   end;

END;

{=========================================================}
PROCEDURE GetExistRec(VAR NewRec : Rec; OldRec : Rec);

{ Accepts input for each of the fields in the record              }

BEGIN
    ShowRec(OldRec);  { Show the old Record as a default }
    With NewRec do
    Begin
       Name      := GetStr(22,11,30,OldRec.Name);
       Street    := GetStr(22,13,20,OldRec.Street);
       Town      := GetStr(22,15,20,OldRec.Town);
       State     := GetStr(50,15,2,OldRec.State);
       Zip       := GetStr(58,15,7,OldRec.Zip);
       Notes1    := GetStr(22,17,43,OldRec.Notes1);
       Notes2    := GetStr(22,19,43,OldRec.Notes2);
   end;

END;

{=========================================================}
FUNCTION InsertLoc(RecNow : Rec) : Integer;

{ Finds the location to insert record RecNow }

VAR
  Located : Boolean;
  Indx    : Integer;

BEGIN
  If NumRec = 0 then Indx := 1   { Handle case of no records }
  Else
  Begin
    Located := False;
    Indx := 0;
    Repeat         { Search through records to find insert location }
      Inc(Indx);
      If (Addr[Indx].Name > RecNow.Name) then Located := True;
    Until Located or (Indx = NumRec);
    If not Located then Indx := NumRec + 1;
  End;
  InsertLoc := Indx;
END;

{=========================================================}
PROCEDURE InsertRec (RecNow : Rec; Indx : Integer);

{ Inserts record RecNow at location Indx }
VAR
  II : Integer;
BEGIN
  If NumRec + 1 < 100 then    { Don't exceed array size }
  Begin
    Inc(NumRec);
    If Indx < NumRec then     { First push the array up }
    For II := NumRec downto Indx do Addr[II] := Addr[II-1];
    Addr[Indx] := RecNow;     { Then insert the new record }
  End
  Else Display('Error -- Too many address records',1,25);
END;

{=================================================================}
PROCEDURE ReadFile;

{ Load the address file and builds the address array. }

VAR
   WorkFile : RecFile;

BEGIN
  NumRec := 0;
  Assign(WorkFile,'ADDRESS.DAT');
  {$I-} Reset(WorkFile); {$I+}
  If IOResult = 0 then
  Begin
    While Not eof (WorkFile) do
      Begin
        Inc(NumRec);                 { Read into the array }
        Read(WorkFile,Addr[NumRec]);
      End;
    Close(WorkFile);
    Display('Address file loaded',1,25);
  End;
END;

{=================================================================}
PROCEDURE WriteFile;

{ Saves the address file to disk. }

VAR
   WorkFile : RecFile;
   II       : Integer;
BEGIN
  Assign(WorkFile,'ADDRESS.DAT');
  ReWrite(WorkFile);
  If NumRec > 0 then
    For II := 1 to NumRec do Write(WorkFile,Addr[II]);
  Close(WorkFile);
  Display('Address file saved',1,25);
END;

{=================================================================}
PROCEDURE SelectRec(VAR Indx : Integer;VAR Escaped : Boolean);

{ Allows the user to browse the list.  The selected record        }
{ is returned in Indx.                                        }

VAR
   VCh        : Char;
   SelectExit : Boolean;

BEGIN

 If NumRec = 0 then Display('The Address List is empty',1,25)
 Else
 Begin
   If (Indx < 1) or (Indx > NumRec) then Indx := 1;
   SelectExit := False;
   Repeat                      { Big record browse loop }
      ShowRec(Addr[Indx]);
      If Indx = 1 then WriteSt(Chr(25)+' ',50,25)
      Else If Indx = NumRec then WriteSt(' '+Chr(24),50,25)
      Else WriteSt(Chr(25)+Chr(24),50,25);
      VCh := NextKey;            { NextKey is a special key reading routine }
                                 { that watches for the help key (F1) and   }
                                 { displays the help screen depending on    }
                                 { the current value of HelpEnv.            }
      If Not FunctKey Then
      Case VCh of
        #13 : Begin              { Enter Key }
               Escaped := False;
               SelectExit := True;
              End;
        #27 : Begin              { Escape Key }
               Escaped := True;
               SelectExit := True;
              End;

         Else Beep;
      End; {Case}

      If (FunctKey) then
      Case VCh  of
        #80,#81 :Begin          { Down arrow & PgDn }
                   If Indx < NumRec
                      then Inc(Indx)
                   Else Beep;
                 End;
       #72,#73 :Begin           { Up arrow and PgUp }
                  If Indx > 1
                    then Dec(Indx)
                  Else Beep;
                End;
        Else Beep;
      End {Case}
    Until SelectExit;          { End of browse loop }
    Display('',1,25);
  End;
 END;

{=================================================================}

{ Main program.                                                   }

BEGIN
 BigExit := false;
 Load_Mem('ADDRESS.LGO');            { Show the BOX logo screen  }
 Display('Loading Help Files',1,25);

 SetHelpMax(4);                       { Set number of help screens }
 HelpLoad(1,'ADDRESS.1');            { Load the BOX help screens  }
 HelpLoad(2,'ADDRESS.2');
 HelpLoad(3,'ADDRESS.3');
 HelpLoad(4,'ADDRESS.4');
 HelpEnv := 1;                        { Set the help environment   }

 Wait;                                { Wait for a keystroke }
 Load_Mem('ADDRESS.SCR');            { Show the BOX data entry screen }

 CurIndx := 1;
 NumRec := 0;
 ReadFile;                            { Load the address file      }
 If NumRec > 0 then ShowRec(Addr[CurIndx]);

 SetMenuBox(12,1,'ADDRESS MANAGER',    { Set up the menu }
                 'Browse Addresses@'+
                 'Add New Address@'+
                 'Change Address@'+
                 'Delete Address@'+
                 'Save Address File@'+
                 'Quit@');

 Repeat Case PickMenuBox of          { Start the big menu loop }

   'B' : Begin                       { Browse }
           If NumRec > 0 then
           Begin
             HelpEnv := 1;             { Set help environment to 1 }
             Display('Use PgUp/PgDn to browse',1,25);
             SelectRec(CurIndx,Escaped);
           End;
         End;

   'A' : Begin                       { Add }
           HelpEnv := 2;             { Set help environment to 2 }
           Repeat
             Display('',1,25);
             GetNewRec(HoldRec);    { Let user input the record }
             If Yes('Add Record Above? (Y or N)') then
             Begin
               CurIndx := InsertLoc(HoldRec);
               InsertRec(HoldRec, CurIndx);
             End;
           Until not Yes('Add Another Record? (Y or N)');
           Display('',1,25);
         End;

   'C' : Begin                       { Change }
           If NumRec > 0 then
           Begin
             HelpEnv := 3;             { Set help environment to 3 }
             Display('Use PgUp/PgDn to select then hit enter to change',1,25);
             SelectRec(CurIndx,Escaped);      { Select a record }
             If not Escaped then

               Begin
                   GetExistRec(HoldRec,Addr[CurIndx]);
                   If Yes('Save Changed Record Above? (Y or N)') then
                   Begin
                     For II := CurIndx to NumRec-1 do Addr[II] := Addr[II+1];
                     Dec(NumRec);
                     CurIndx := InsertLoc(HoldRec);
                     InsertRec(HoldRec, CurIndx);
                   End;
              End;   { not escaped }
            End;     { NumRec > 0 }
          End;

   'D' : Begin                    { Delete }
           If NumRec > 0 then
           Begin
             HelpEnv := 4;          { Set help environment to 4 }
             Display('Use PgUp/PgDn to select then hit enter to delete',1,25);
             SelectRec(CurIndx,Escaped);                        { Select a record }
             If not Escaped then
             Begin
               For II := CurIndx to NumRec do Addr[II] := Addr[II+1];
               Dec(NumRec);
             End;
             CurIndx := 1;
             ShowRec(Addr[CurIndx]);
           End;
         End;

   'S' : WriteFile;               { Save }

   #0,'Q' : BigExit := True;      { Quit (note that esc. returns #0)}

   End;               { of case pickmenubox }
   ResetBox;          { rebuild the menu }
   HelpEnv := 1;      { Set help environment back to 1 (general help) }
   Display('',1,25);  { blank the bottom line of the screen }
  Until BigExit;
END.                  { That's all }